Dataset: Qualidade dos Vinhos

Dataset realicionado com amostras de vinhos tintos e brancos do norte de Portugal.
O objetivo é estimar a qualidade do vinho com base em suas características físico-químicas.

Ánalise Exploratória

Amostra do dataset

fixedacidity	volatileacidity	citricacid	residualsugar	chlorides	freesulfurdioxide	totalsulfurdioxide	density	pH	sulphates	alcohol	quality	Vinho
6.6	0.24	0.35	7.70	0.031	36	135	0.99380	3.19	0.37	10.5	5	WHITE
6.7	0.34	0.43	1.60	0.041	29	114	0.99014	3.23	0.44	12.6	6	WHITE
10.6	0.31	0.49	2.20	0.063	18	40	0.99760	3.14	0.51	9.8	6	RED
5.4	0.18	0.24	4.80	0.041	30	113	0.99445	3.42	0.40	9.4	6	WHITE
6.7	0.30	0.44	18.75	0.057	65	224	0.99956	3.11	0.53	9.1	5	WHITE
6.8	0.50	0.11	1.50	0.075	16	49	0.99545	3.36	0.79	9.5	5	RED

Verifica se há valores ausentes (NAs)

sapply(Vinhos, function(x)all(is.na(x)))

##       fixedacidity    volatileacidity         citricacid 
##              FALSE              FALSE              FALSE 
##      residualsugar          chlorides  freesulfurdioxide 
##              FALSE              FALSE              FALSE 
## totalsulfurdioxide            density                 pH 
##              FALSE              FALSE              FALSE 
##          sulphates            alcohol            quality 
##              FALSE              FALSE              FALSE 
##              Vinho 
##              FALSE

Observamos que não há nenhum valor ausente/faltante nesse dataset. Dessa forma, eliminamos a necessidade de tratar esses valores.

Verifica se há preditores com variância próxima de zero

nearZeroVar(Vinhos)

## integer(0)

Não diagnosticamos preditores com um valor exclusivo (ou seja, preditores de variação zero) ou preditores com poucos valores exclusivos em relação ao número de amostras.

Resumo do dataset

## 'data.frame':    6497 obs. of  13 variables:
##  $ fixedacidity      : num  6.6 6.7 10.6 5.4 6.7 6.8 6.6 7.2 5.1 6.2 ...
##  $ volatileacidity   : num  0.24 0.34 0.31 0.18 0.3 0.5 0.61 0.66 0.26 0.22 ...
##  $ citricacid        : num  0.35 0.43 0.49 0.24 0.44 0.11 0 0.33 0.33 0.2 ...
##  $ residualsugar     : num  7.7 1.6 2.2 4.8 18.8 ...
##  $ chlorides         : num  0.031 0.041 0.063 0.041 0.057 0.075 0.069 0.068 0.027 0.035 ...
##  $ freesulfurdioxide : num  36 29 18 30 65 16 4 34 46 58 ...
##  $ totalsulfurdioxide: num  135 114 40 113 224 49 8 102 113 184 ...
##  $ density           : num  0.994 0.99 0.998 0.994 1 ...
##  $ pH                : num  3.19 3.23 3.14 3.42 3.11 3.36 3.33 3.27 3.35 3.11 ...
##  $ sulphates         : num  0.37 0.44 0.51 0.4 0.53 0.79 0.37 0.78 0.43 0.53 ...
##  $ alcohol           : num  10.5 12.6 9.8 9.4 9.1 9.5 10.4 12.8 11.4 9 ...
##  $ quality           : int  5 6 6 6 5 5 4 6 7 6 ...
##  $ Vinho             : Factor w/ 2 levels "RED","WHITE": 2 2 1 2 2 1 1 1 2 2 ...

O dataset possui 6497 observações de 13 variáveis. Sendo elas numéricas, inteiras e fatoriais.

Dentre essas observações, podemos observar que a quantidade de vinhos brancos é maior do que vinhos tintos, conforme o gráfico abaixo:

barplot(table(Vinho), col=c(red_color, white_color))

Executando o summary:

##   fixedacidity    volatileacidity    citricacid     residualsugar  
##  Min.   : 3.800   Min.   :0.0800   Min.   :0.0000   Min.   : 0.60  
##  1st Qu.: 6.400   1st Qu.:0.2300   1st Qu.:0.2500   1st Qu.: 1.80  
##  Median : 7.000   Median :0.2900   Median :0.3100   Median : 3.00  
##  Mean   : 7.215   Mean   :0.3397   Mean   :0.3186   Mean   : 5.44  
##  3rd Qu.: 7.700   3rd Qu.:0.4000   3rd Qu.:0.3900   3rd Qu.: 8.10  
##  Max.   :15.900   Max.   :1.5800   Max.   :1.6600   Max.   :45.80  
##    chlorides       freesulfurdioxide totalsulfurdioxide    density      
##  Min.   :0.00900   Min.   :  1.00    Min.   :  6.0      Min.   :0.9871  
##  1st Qu.:0.03800   1st Qu.: 17.00    1st Qu.: 77.0      1st Qu.:0.9923  
##  Median :0.04700   Median : 29.00    Median :118.0      Median :0.9949  
##  Mean   :0.05603   Mean   : 30.53    Mean   :115.7      Mean   :0.9947  
##  3rd Qu.:0.06500   3rd Qu.: 41.00    3rd Qu.:156.0      3rd Qu.:0.9970  
##  Max.   :0.61100   Max.   :289.00    Max.   :440.0      Max.   :1.0140  
##        pH          sulphates         alcohol           quality     
##  Min.   :2.720   Min.   :0.2200   Min.   : 0.9567   Min.   :3.000  
##  1st Qu.:3.110   1st Qu.:0.4300   1st Qu.: 9.5000   1st Qu.:5.000  
##  Median :3.210   Median :0.5100   Median :10.3000   Median :6.000  
##  Mean   :3.219   Mean   :0.5313   Mean   :10.4862   Mean   :5.818  
##  3rd Qu.:3.320   3rd Qu.:0.6000   3rd Qu.:11.3000   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.9000   Max.   :9.000  
##    Vinho     
##  RED  :1599  
##  WHITE:4898  
##              
##              
##              
##

Observamos que as variáveis residualsugar, chlorides, freesulfurdioxide e totalsulfurdioxide possuem valores muito distantes entre mínimo e máximo. Isso pode indicar outliers e/ou desequilíbrio entre a quantidade de vinhos tintos e brancos, o que pode interferir nos resultados de classificação.

Nessa tabela podemos observar a combinação entre o tipo do vinho e a nota de qualidade:

##        quality
## Vinho      3    4    5    6    7    8    9
##   RED     10   53  681  638  199   18    0
##   WHITE   20  163 1457 2198  880  175    5

Com esse output, notamos que apenas vinhos brancos possuem a nota máxima em relação a qualidade.
Tanto para vinhos tintos quanto brancos, as notas 5 e 6 concentram a maior parte dos vinhos.

Histograma das variáveis

Simétrico
Contêm a partir do centro do gráfico o maior número de dados.
Assimétrico à direita
Indica a ocorrência de altos valores com baixa frequência.
Assimétrico à esquerda
A frequência dos dados está concentrada nos altos valores.
Bimodal
Há o aparecimento de dois picos.
Multimodal
Há o aparecimento de vários picos.

Encontrando as variáveis mais relevantes

library(randomForest)

## randomForest 4.6-14

## Type rfNews() to see new features/changes/bug fixes.

## 
## Attaching package: 'randomForest'

## The following object is masked from 'package:outliers':
## 
##     outlier

## The following object is masked from 'package:ggplot2':
## 
##     margin

## The following object is masked from 'package:dplyr':
## 
##     combine

rfModel = randomForest( Vinhos$quality ~ ., data=Vinhos, ntree=500 ) 
varImpPlot(rfModel)

Ánalise de outliers

Abaixo temos o boxplot de todas as variáveis do dataset:

Com os gráficos acima foi observado que todas as variáveis possuem candidatos a outliers.
No dataset existem variáveis como residualsugar que possuem o valor máximo muito acima do terceiro quartil, isso pode gerar distorções nos algoritmos que serão executado a seguir. Além disso há uma concentração de outliers nessas variáriveis, o que traz a necessidade de removê-los para evitar distorção nos passos seguintes.

Nivelamento

VinhosOut <- Vinhos[Vinhos$quality > quantile(Vinhos$quality, .25) - 1.5*IQR(Vinhos$quality) & Vinhos$quality < quantile(Vinhos$quality, .75) + 1.5*IQR(Vinhos$quality), ]

Correlação

Para realizar a correlação transformamos o campo Vinho (fator) para tipo numérico. Além de normalizar os dados para evitar algum tipo de distorção.

VinhosOut$Vinho <- as.numeric(VinhosOut$Vinho)
norm_vinhos <- VinhosOut %>% mutate_at(c(1,2,3,4,5,6,7,8,9,10,11,13), list( ~ c(scale(.))))

Obs.: Dataset sem outliers.

Outra forma de visualização da correlação das variáveis:

Com o gráfico de correlação podemos observar alguns pontos:
* O alcool tem uma anti-correlação alta com density
* O freesulfurdioxide tem uma correlação possitiva alta comtotalsulfurdioxide
* O volatileacidity tem uma anti-correlação alta com o tipo do vinho
* O totalsulfurdioxide tem uma correlação possitiva alta com o tipo do vinho
* As outras correlações não são tão significativas no dataset, nesse momento.

Explicando a variável Quality

Preparação para separação de dados: treinamento e teste

Iremos separar a base de dados em 25% para testes e 75% para treino. Conforme output abaixo:

norm_vinhos = data.frame(norm_vinhos)
dt_list = split_df(norm_vinhos, ratio = 0.75, seed = 66)
train = dt_list$train
test = dt_list$test

Validando a consistência de qualidade entre as bases de treino e teste

## 
##          4          5          6          7 
## 0.03359558 0.34616202 0.45183925 0.16840315

## 
##          4          5          6          7 
## 0.03703704 0.32567050 0.45402299 0.18326948

As proporções estão, consideravelemente, bem distribuídas entre a qualidade. Dessa forma, conseguimos realizar um bom treinamento para o modelo.

Regressão Linear

No primeiro modelo mantemos todas as varáveis:

## 
## Call:
## lm(formula = train$quality ~ train$fixedacidity + train$volatileacidity + 
##     train$citricacid + train$residualsugar + train$chlorides + 
##     train$freesulfurdioxide + train$totalsulfurdioxide + train$density + 
##     train$pH + train$sulphates + train$alcohol + train$Vinho)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.70344 -0.43181 -0.02767  0.45035  2.10879 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               5.760137   0.009473 608.028  < 2e-16 ***
## train$fixedacidity        0.153899   0.021069   7.305 3.25e-13 ***
## train$volatileacidity    -0.219021   0.014046 -15.593  < 2e-16 ***
## train$citricacid         -0.019031   0.011968  -1.590 0.111858    
## train$residualsugar       0.324917   0.028395  11.443  < 2e-16 ***
## train$chlorides          -0.034948   0.011784  -2.966 0.003035 ** 
## train$freesulfurdioxide   0.084020   0.014315   5.869 4.68e-09 ***
## train$totalsulfurdioxide -0.071886   0.019182  -3.748 0.000181 ***
## train$density            -0.407209   0.042495  -9.583  < 2e-16 ***
## train$pH                  0.087345   0.015096   5.786 7.68e-09 ***
## train$sulphates           0.120756   0.011874  10.170  < 2e-16 ***
## train$alcohol             0.148646   0.020811   7.143 1.06e-12 ***
## train$Vinho              -0.188577   0.025652  -7.351 2.30e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6494 on 4690 degrees of freedom
## Multiple R-squared:  0.286,  Adjusted R-squared:  0.2841 
## F-statistic: 156.5 on 12 and 4690 DF,  p-value: < 2.2e-16

Nesse primeiro modelo a variável citricacid não possui muita relevância pois o seu p-value está próximo a 1.
Para ter certeza sobre essa informação, utilizamos o método stepwise para identificar quais são as variáveis relavantes para o modelo.

## Start:  AIC=-4047.87
## train$quality ~ train$fixedacidity + train$volatileacidity + 
##     train$citricacid + train$residualsugar + train$chlorides + 
##     train$freesulfurdioxide + train$totalsulfurdioxide + train$density + 
##     train$pH + train$sulphates + train$alcohol + train$Vinho
## 
##                            Df Sum of Sq    RSS     AIC
## <none>                                  1977.8 -4047.9
## - train$citricacid          1     1.066 1978.8 -4047.3
## - train$chlorides           1     3.709 1981.5 -4041.1
## - train$totalsulfurdioxide  1     5.922 1983.7 -4035.8
## - train$pH                  1    14.117 1991.9 -4016.4
## - train$freesulfurdioxide   1    14.527 1992.3 -4015.4
## - train$alcohol             1    21.514 1999.3 -3999.0
## - train$fixedacidity        1    22.501 2000.3 -3996.7
## - train$Vinho               1    22.789 2000.6 -3996.0
## - train$density             1    38.723 2016.5 -3958.7
## - train$sulphates           1    43.612 2021.4 -3947.3
## - train$residualsugar       1    55.217 2033.0 -3920.4
## - train$volatileacidity     1   102.529 2080.3 -3812.2

Confiança desse modelo é:

##                                2.5 %       97.5 %
## (Intercept)               5.74156468  5.778709611
## train$fixedacidity        0.11259442  0.195204549
## train$volatileacidity    -0.24655872 -0.191483565
## train$citricacid         -0.04249383  0.004431367
## train$residualsugar       0.26924956  0.380584049
## train$chlorides          -0.05805011 -0.011845734
## train$freesulfurdioxide   0.05595510  0.112084743
## train$totalsulfurdioxide -0.10949146 -0.034279577
## train$density            -0.49051957 -0.323899411
## train$pH                  0.05774965  0.116940829
## train$sulphates           0.09747658  0.144034765
## train$alcohol             0.10784644  0.189446471
## train$Vinho              -0.23886764 -0.138286615

Modelo sem a variável de citricidade:

## 
## Call:
## lm(formula = train$quality ~ train$fixedacidity + train$volatileacidity + 
##     train$residualsugar + train$chlorides + train$freesulfurdioxide + 
##     train$totalsulfurdioxide + train$density + train$pH + train$sulphates + 
##     train$alcohol + train$Vinho)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.72469 -0.43083 -0.02888  0.45193  2.07950 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               5.760165   0.009475 607.933  < 2e-16 ***
## train$fixedacidity        0.146376   0.020534   7.128 1.17e-12 ***
## train$volatileacidity    -0.211746   0.013283 -15.942  < 2e-16 ***
## train$residualsugar       0.325473   0.028397  11.461  < 2e-16 ***
## train$chlorides          -0.037906   0.011638  -3.257  0.00113 ** 
## train$freesulfurdioxide   0.083967   0.014318   5.865 4.81e-09 ***
## train$totalsulfurdioxide -0.075122   0.019077  -3.938 8.34e-05 ***
## train$density            -0.409961   0.042467  -9.654  < 2e-16 ***
## train$pH                  0.089450   0.015041   5.947 2.92e-09 ***
## train$sulphates           0.119286   0.011840  10.075  < 2e-16 ***
## train$alcohol             0.145248   0.020705   7.015 2.62e-12 ***
## train$Vinho              -0.191616   0.025585  -7.489 8.22e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6495 on 4691 degrees of freedom
## Multiple R-squared:  0.2856, Adjusted R-squared:  0.2839 
## F-statistic: 170.5 on 11 and 4691 DF,  p-value: < 2.2e-16

O R-quadrado é de mais ou menos 30, o que significa que a regressão linear não descreve o modelo com tanta precisão.

Abaixo o modelo para base testes:

modeloTestSemCitricidade <- lm(test$quality ~ test$fixedacidity + test$volatileacidity + test$residualsugar + test$chlorides + test$freesulfurdioxide + test$totalsulfurdioxide+ test$density + test$pH + test$sulphates + test$alcohol + test$Vinho)

summary(modeloTestSemCitricidade)

## 
## Call:
## lm(formula = test$quality ~ test$fixedacidity + test$volatileacidity + 
##     test$residualsugar + test$chlorides + test$freesulfurdioxide + 
##     test$totalsulfurdioxide + test$density + test$pH + test$sulphates + 
##     test$alcohol + test$Vinho)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.16513 -0.43737 -0.02119  0.46965  1.89032 
## 
## Coefficients:
##                         Estimate Std. Error t value Pr(>|t|)    
## (Intercept)              5.77063    0.01667 346.194  < 2e-16 ***
## test$fixedacidity        0.15255    0.03772   4.044 5.50e-05 ***
## test$volatileacidity    -0.24382    0.02265 -10.767  < 2e-16 ***
## test$residualsugar       0.29412    0.05431   5.416 7.05e-08 ***
## test$chlorides           0.02706    0.02394   1.130 0.258605    
## test$freesulfurdioxide   0.10138    0.02464   4.114 4.09e-05 ***
## test$totalsulfurdioxide -0.07138    0.03343  -2.135 0.032919 *  
## test$density            -0.32288    0.08511  -3.794 0.000154 ***
## test$pH                  0.13440    0.02677   5.020 5.76e-07 ***
## test$sulphates           0.09152    0.02051   4.462 8.68e-06 ***
## test$alcohol             0.21947    0.04314   5.087 4.08e-07 ***
## test$Vinho              -0.13354    0.04634  -2.882 0.004010 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6566 on 1554 degrees of freedom
## Multiple R-squared:  0.2989, Adjusted R-squared:  0.294 
## F-statistic: 60.24 on 11 and 1554 DF,  p-value: < 2.2e-16

O modelo criado através da técnica de regressão linear não descreve muito bem a nota de qualidade dos vinhos, com uma acertividade de aproximadamente 30%. Não será necessário fazer o modelo de predição, devido ao baixo índice de acertividade.

Análise de Resíduos

Esse gráfico de resíduos apresenta a distância entre o valor estimado x valor real. Então, quanto mais próximo de zero o ponto estiver melhor é a assertividade do modelo.

Executa a predição do modelo:

## [1] 0.6243183

O percentual de acerto do modelo é de 62,43%

Executando o teste de shapiro no modelo:

## 
##  Shapiro-Wilk normality test
## 
## data:  residuals(modeloTestSemCitricidade)
## W = 0.99692, p-value = 0.003428

Como o p-value resultou em um valor menor que 0,05, não podemos assumir a normalidade.
Pode-se dizer que temos um modelo de regressão com pouca assertividade.
Isso corrobora com o valor d R-Quadrado demonstrando que modelo não é assertivo.

Árvore de Regressão

A seguir será executado a árvore de regressão para comparar com a regressão linear.
A árvore de regressão é um método de aprendizado supervisionado utilizado para classificação e regressão.
A variável target é a quality e as variáveis que utilizaremos para prever o seu valor são: fixedacidity, volatileacidity, citricacid, residualsugar, chlorides, freesulfurdioxide, totalsulfurdioxide, density, pH,sulphates,alcohol.

arvore_regressao = rpart (quality ~ fixedacidity + volatileacidity + citricacid + residualsugar + chlorides + freesulfurdioxide + totalsulfurdioxide + density + pH + sulphates + alcohol,data=train, cp = 0.007, minsplit = 15, maxdepth=30)

rpart.plot(arvore_regressao, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
           fallen.leaves=FALSE,   digits=2, varlen=-10, faclen=20,
           cex=0.4, tweak=1.7,
           compress=TRUE, 
           snip=FALSE)

## Warning: labs do not fit even at cex 0.15, there may be some overplotting

## Warning: cex and tweak both specified, applying both

Para esse plot, conseguimos visualizr variáveis representativas como: alcohol, volatileacidity, residualsugar.

Testando a árvore de regressão

Erro utilizando o modelo de árvore de regressão:

Val_pred_tree = predict(arvore_regressao,interval = "prediction", level = 0.95) 

mse_tree = mean((quality - Val_pred_tree)^2)
sqrt(mse_tree)

## [1] 0.6576832

Erro utilizando média:

erro_usando_media = mean((train$quality - mean(train$quality))^2)
sqrt(erro_usando_media)

## [1] 0.7674288

Pode-se dizer que o modelo de árvore de regressão é mais acertivo que o modelo de regressão linear. E pode-se dizer que a árvore tem uma acertividade melhor do que informando apenas a média como explicação da qualidade.

E para árvore de regressão pode-se dizer que a quantide de alcohol é fundamental para a qualidade do vinho seguindo de volatileacidity.

Classificando Vinhos em Bom ou Ruim considerando a variável Quality

Adicionando a coluna de classificação dos vinhos e já separando base em teste/treino:

vinhos_com_classificacao = VinhosOut
vinhos_com_classificacao$classificacao = ifelse(vinhos_com_classificacao$quality >= 6,  T, F)
dt_list_log = split_df(vinhos_com_classificacao, ratio = 0.75, seed = 66)
train_log = dt_list_log$train
test_log = dt_list_log$test
attach(train_log)

## The following objects are masked from train:
## 
##     alcohol, chlorides, citricacid, density, fixedacidity,
##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
##     totalsulfurdioxide, Vinho, volatileacidity

## The following objects are masked from Vinhos:
## 
##     alcohol, chlorides, citricacid, density, fixedacidity,
##     freesulfurdioxide, pH, quality, residualsugar, sulphates,
##     totalsulfurdioxide, Vinho, volatileacidity

Executando o modelo com todos as variáveis:

modelo_logistico <- rpart (as.factor(classificacao) ~ fixedacidity+volatileacidity+citricacid+residualsugar+chlorides+freesulfurdioxide+totalsulfurdioxide+density+pH+sulphates+alcohol, maxdepth=20, train_log)

Resultado do modelo:

Testando o modelo

Matriz de confusão

previsto.com.modelo<-predict(modelo_logistico, train_log, type='class')

matriz.de.confusao<-table(train_log$classificacao, previsto.com.modelo)
matriz.de.confusao

##        previsto.com.modelo
##         FALSE TRUE
##   FALSE   974  812
##   TRUE    457 2460

Calculando a diagonal da matriz

diagonal <- diag(matriz.de.confusao)
Acc <-  sum(diagonal)/sum(matriz.de.confusao)
Acc

Executando o algoritmo para base de testes

previsto.valid<-predict(modelo_logistico, test_log , type='class')

test$previsto=previsto.valid
test$classificacao <- ifelse(test$quality >= 6, T, F)
test$errou = ifelse(test$previsto != test$classificacao, 1, 0)

Matriz de confusão para a base teste

previsto.com.modelo<-predict(modelo_logistico, test_log, type='class')

matriz.de.confusao<-table(test_log$classificacao, previsto.com.modelo)
matriz.de.confusao

##        previsto.com.modelo
##         FALSE TRUE
##   FALSE   287  281
##   TRUE    148  850

Calculando a diagonal da matriz

diagonal <- diag(matriz.de.confusao)
Acc <-  sum(diagonal)/sum(matriz.de.confusao)
Acc

Clusterizando os Vinhos

Como técnica não supervisionada, vamos testar se o algoritmo de clusterização será adequado para agrupar dois conjunto de vinhos, categorizando-os como vinhos bons e vinhos ruins.

A variável quality, que identifica a nota do vinho, será a variável utilizada para correlacionar com as demais variáveis para identificar se existe algum agrupamento entre os vinhos.

De acordo com Luis Costa de Oliveira, Sara Oliveira, Maria Eugenia em seu artigo ‘Avaliação das características físico-químicas e colorimétricas de vinhos finos’, a cor não é uma característica físico-química. Portanto foi removida a coluna tipo de vinho.

fixedacidity	volatileacidity	citricacid	residualsugar	chlorides	freesulfurdioxide	totalsulfurdioxide	density	pH	sulphates	alcohol	quality
-0.4812215	-0.6119896	0.2164618	0.4756240	-0.7226559	0.3258548	0.3420085	-0.3264022	-0.1749092	-1.0921311	0.0423620	5
-0.4040769	-0.0021256	0.7632805	-0.8106493	-0.4383161	-0.0784338	-0.0293492	-1.5741567	0.0740986	-0.6202746	1.8002547	6
2.6045621	-0.1850848	1.1733945	-0.6841306	0.1872316	-0.7137445	-1.3379431	0.9690807	-0.4861688	-0.1484182	-0.5436022	6
-1.4069566	-0.9779079	-0.5354139	-0.1358830	-0.4383161	-0.0206783	-0.0470329	-0.1048064	1.2568852	-0.8899069	-0.8784389	6
-0.4040769	-0.2460712	0.8316328	2.8056765	0.0166277	2.0007647	1.9158579	1.6372771	-0.6729246	-0.0136020	-1.1295665	5
-0.3269324	0.9736567	-1.4239943	-0.8317358	0.5284394	-0.8292555	-1.1787898	0.2361101	0.8833737	1.7390077	-0.7947298	5

Método hierárquico

hier_cluster<-hclust(dist(vinhos_noColor),method='ward.D2')
d <- dist(norm_vinhos, method = "euclidean") 
plot(hier_cluster, ylab='distancia', cex=0.6)

groups <- cutree(hier_cluster, k=4)
rect.hclust(hier_cluster, k=4, border="red")

* Divisão por 4 clusters.

Método não hierárquico

Utilizando o K-means para descobrir a quantidade ideal de clusters dentro de 10 iterações.

set.seed(45)
wss = 0
for (i in 1:10) {
  wine_cluster <- kmeans(vinhos_noColor, centers = i)
  wss[i] <- wine_cluster$tot.withinss
}
plot(1:10, wss, type = "b",  main="Elbow method",
     xlab = "Number of Clusters", 
     ylab = "Within groups sum of squares",pch=8, col="red")

Com base na plotagem, podemos determinar que, após o cluster 3, não vemos uma grande queda na soma das distâncias quadradas dentro de cada cluster, portanto, podemos considerar o valor de K como 3 e prosseguir com o agrupamento.

K-Means Segmentation

## K-means clustering with 3 clusters of sizes 2842, 1574, 1853
## 
## Cluster means:
##   fixedacidity volatileacidity   citricacid residualsugar  chlorides
## 1   -0.3468971      -0.4233652  0.004285744    -0.4483549 -0.4379859
## 2    0.8624373       1.1769188 -0.326405161    -0.6076420  0.9196867
## 3   -0.2005368      -0.3503866  0.270686260     1.2038063 -0.1094608
##   freesulfurdioxide totalsulfurdioxide    density          pH  sulphates
## 1       -0.09039339         0.03739092 -0.8786450 -0.05406331 -0.2867921
## 2       -0.84292382        -1.19075490  0.7006338  0.54122535  0.8277140
## 3        0.85464658         0.95411939  0.7524616 -0.37681639 -0.2632265
##      alcohol  quality
## 1  0.5694176 5.989796
## 2 -0.1275825 5.572427
## 3 -0.7649595 5.574204
## 
## Clustering vector:
##    [1] 1 1 2 1 3 2 2 2 1 3 3 3 3 1 1 1 2 1 2 3 1 3 2 1 1 1 1 2 2 3 1 2 2 1
##   [35] 2 2 1 3 1 3 3 3 1 2 1 3 1 1 1 1 1 1 1 2 1 1 1 2 2 1 3 1 1 2 1 1 2 1
##   [69] 3 1 1 3 2 1 2 2 1 1 3 1 2 2 2 2 1 3 2 1 2 3 1 1 3 3 1 1 1 2 1 1 1 2
##  [103] 1 1 1 1 3 1 1 1 1 1 1 1 1 2 3 1 3 1 1 2 2 3 2 2 1 3 2 2 3 1 3 3 3 1
##  [137] 3 1 1 2 3 2 2 1 1 1 1 2 3 3 3 2 3 3 1 3 2 1 2 1 1 1 2 2 3 3 1 1 1 2
##  [171] 1 3 1 2 3 2 1 1 3 3 1 3 1 3 1 2 1 3 1 3 3 1 3 2 3 1 3 1 2 3 2 1 1 2
##  [205] 2 1 3 1 1 3 3 3 1 3 3 2 2 1 1 3 2 1 1 3 2 2 3 2 2 3 2 2 2 3 1 1 1 1
##  [239] 3 1 3 1 1 1 1 3 2 3 3 3 2 2 2 1 1 1 1 3 1 1 3 3 1 2 1 3 2 2 1 3 2 2
##  [273] 1 2 2 3 1 3 1 1 1 2 1 2 3 2 1 3 3 2 2 1 3 1 2 2 3 1 2 2 2 1 3 2 1 2
##  [307] 2 3 3 1 3 1 1 1 2 2 3 2 1 3 3 2 2 1 3 2 3 1 2 1 3 1 2 2 2 1 1 1 1 1
##  [341] 1 1 3 1 1 1 1 1 3 1 1 2 1 3 1 1 3 1 3 2 1 2 1 1 1 3 2 2 3 3 2 1 1 1
##  [375] 1 2 1 3 2 3 1 2 2 1 3 2 1 3 1 1 3 1 1 2 2 1 1 3 1 1 3 2 2 3 3 3 3 3
##  [409] 1 1 1 1 2 1 3 2 3 1 1 1 3 1 3 3 3 3 2 3 1 2 1 1 3 1 3 3 3 1 1 1 1 3
##  [443] 2 1 1 1 3 3 1 1 1 1 1 1 1 3 1 1 1 2 1 1 1 1 3 1 1 3 3 3 1 1 2 3 1 2
##  [477] 3 1 1 1 1 1 1 2 1 1 1 2 3 2 3 3 3 2 1 1 3 2 2 3 3 1 1 3 3 1 1 3 1 1
##  [511] 2 1 1 2 3 2 2 3 3 2 1 1 2 3 1 2 3 3 3 3 3 1 1 2 1 2 1 1 1 3 3 3 3 1
##  [545] 1 2 1 3 1 1 1 1 3 3 3 1 1 2 1 1 3 3 2 1 2 3 3 2 2 3 2 1 3 3 1 3 3 3
##  [579] 3 3 2 2 2 2 2 1 3 1 1 1 2 3 1 2 1 2 1 1 3 1 1 2 1 2 1 2 3 2 2 3 3 3
##  [613] 1 1 3 2 1 3 1 3 1 1 1 1 3 3 3 1 1 2 1 1 2 3 1 2 2 1 1 2 2 3 1 1 1 2
##  [647] 3 3 1 1 1 1 3 2 1 3 2 3 2 3 3 1 2 1 3 1 2 2 1 1 2 1 3 3 3 3 1 2 1 1
##  [681] 2 1 1 3 1 2 1 2 1 1 3 1 3 1 1 1 3 3 3 3 1 1 1 1 1 1 2 1 3 3 3 1 1 2
##  [715] 2 3 1 1 1 2 1 1 2 2 2 2 1 2 1 3 1 2 2 2 3 2 1 1 2 1 2 1 2 3 2 3 1 1
##  [749] 2 1 3 3 1 1 1 2 3 1 1 1 2 2 2 1 1 2 1 3 2 3 1 1 1 1 1 2 1 3 2 2 1 1
##  [783] 3 3 2 3 3 2 3 1 1 2 2 2 2 3 3 3 2 1 1 1 1 3 3 1 1 1 3 1 1 1 2 3 1 3
##  [817] 3 3 3 1 2 2 1 3 3 1 1 1 3 2 1 1 2 1 1 2 1 1 3 1 3 1 3 2 1 1 1 2 2 2
##  [851] 2 1 1 1 2 1 3 1 1 1 1 1 2 1 1 2 1 1 2 1 3 1 3 3 3 2 3 1 2 1 3 3 1 2
##  [885] 3 2 2 1 1 1 2 1 2 1 1 1 1 1 3 2 3 1 3 2 3 1 1 2 2 1 2 2 1 2 2 1 3 1
##  [919] 1 1 1 1 2 1 3 1 1 1 3 2 1 3 1 2 2 3 2 1 2 2 3 1 1 1 1 2 3 3 1 3 1 3
##  [953] 2 3 2 1 3 1 1 2 1 3 2 1 2 3 2 2 1 1 1 3 3 1 2 1 3 3 1 3 3 3 3 3 3 2
##  [987] 2 3 1 2 2 1 1 3 2 3 3 2 1 3 3 1 2 2 3 3 3 1 3 1 1 1 1 1 2 3 2 1 1 1
## [1021] 1 2 1 3 2 1 1 3 1 2 3 2 2 3 3 1 2 1 1 2 3 3 1 2 3 1 2 2 1 1 2 3 3 2
## [1055] 3 2 2 1 3 3 1 2 1 3 1 3 1 2 3 1 3 1 1 2 1 2 1 2 3 3 1 1 1 1 3 1 2 1
## [1089] 1 1 3 1 3 3 3 1 3 1 1 1 2 3 1 1 2 3 1 3 3 1 3 1 1 2 1 1 1 2 1 1 2 3
## [1123] 3 2 3 1 3 1 2 2 1 3 3 1 1 1 1 1 3 1 1 1 3 2 3 2 2 3 3 3 1 1 2 2 1 3
## [1157] 1 3 2 1 3 2 1 3 3 2 2 3 2 1 1 1 2 1 1 2 3 2 2 3 3 2 1 1 3 3 2 1 1 3
## [1191] 1 1 2 1 3 3 3 2 1 2 1 3 3 1 1 2 2 1 1 3 1 2 1 3 1 1 1 1 1 1 1 1 1 2
## [1225] 2 2 2 3 1 3 1 1 2 2 1 1 2 2 1 3 3 2 2 2 1 3 1 2 3 3 3 1 3 1 1 2 1 3
## [1259] 1 1 3 1 1 1 3 3 3 1 2 2 3 3 2 3 1 1 1 3 1 1 2 1 1 1 3 3 2 2 3 2 1 2
## [1293] 3 3 2 2 2 1 3 1 3 1 1 2 1 1 2 2 3 1 1 1 1 2 2 1 2 2 3 1 1 2 1 1 1 3
## [1327] 1 1 2 2 1 1 1 1 3 1 1 1 1 2 3 1 1 3 3 3 1 3 3 1 1 1 3 3 3 1 1 2 2 3
## [1361] 2 1 3 3 2 3 2 3 2 3 3 1 1 3 3 1 2 1 1 1 1 3 1 1 2 1 3 3 2 1 1 1 1 3
## [1395] 2 3 2 2 3 1 3 3 1 2 3 2 1 1 1 1 2 3 1 2 3 3 2 2 3 1 2 2 3 1 2 2 1 2
## [1429] 3 3 1 3 2 2 1 1 3 1 1 2 3 3 2 1 1 2 2 1 1 1 1 1 2 3 2 3 1 3 3 1 1 1
## [1463] 1 3 1 3 2 3 2 1 3 3 1 3 3 1 2 1 3 3 1 1 3 3 3 2 1 1 2 3 2 3 1 2 3 1
## [1497] 1 1 3 1 1 2 2 1 3 1 1 1 1 2 1 1 3 3 3 1 1 3 1 2 1 1 1 2 3 3 1 2 1 3
## [1531] 2 3 1 1 1 1 3 3 2 1 3 3 1 1 3 1 1 1 1 3 3 3 2 1 1 1 1 3 1 3 1 1 3 3
## [1565] 3 1 2 1 2 1 3 1 2 3 1 2 1 1 1 1 1 2 1 3 2 3 2 1 2 3 1 2 2 1 1 1 2 1
## [1599] 1 2 1 1 1 3 1 1 1 3 1 2 1 3 1 1 3 3 1 1 3 2 3 2 1 1 3 1 2 2 1 1 2 1
## [1633] 2 1 1 2 2 3 2 2 2 1 1 2 2 1 2 3 1 1 1 1 1 2 1 1 1 1 1 2 1 1 3 2 1 1
## [1667] 3 2 3 1 3 2 3 2 1 3 1 1 3 1 2 1 2 2 2 1 1 1 1 1 3 1 3 2 2 1 2 3 1 2
## [1701] 1 3 2 1 1 2 3 1 1 1 2 2 1 3 1 1 1 1 1 3 1 3 3 1 2 2 2 2 3 1 3 3 1 3
## [1735] 1 3 2 1 1 2 1 3 1 1 3 3 3 2 3 1 1 1 3 3 2 2 1 2 3 3 1 3 3 1 1 3 2 1
## [1769] 2 2 1 2 1 1 1 2 1 3 1 3 3 1 2 3 1 1 3 1 1 1 1 3 1 1 1 1 2 2 2 1 3 1
## [1803] 1 2 2 1 3 1 1 1 2 1 1 3 2 3 1 2 1 3 3 3 1 1 2 3 3 3 3 2 2 3 1 2 3 1
## [1837] 1 1 3 3 3 2 1 3 2 3 1 3 1 3 1 1 1 1 1 2 1 1 3 1 2 1 1 3 1 3 2 1 2 3
## [1871] 1 3 1 3 3 1 3 1 1 2 1 1 3 3 3 1 1 3 2 2 3 3 1 1 1 3 3 3 1 1 1 2 2 1
## [1905] 3 1 1 1 1 1 1 3 2 2 2 1 1 1 3 2 1 1 3 2 1 2 3 3 1 3 1 1 1 3 2 1 2 3
## [1939] 3 2 1 3 1 1 1 3 1 2 3 1 2 3 1 1 1 2 1 1 3 1 1 2 1 2 3 2 1 3 3 2 2 1
## [1973] 2 1 1 3 1 1 1 2 2 3 2 2 3 1 1 1 2 3 1 2 3 1 3 3 1 3 3 3 1 1 1 1 2 3
## [2007] 1 2 1 2 3 1 3 1 3 2 2 1 1 3 1 1 1 1 3 1 1 1 1 1 3 1 2 3 1 3 3 3 1 2
## [2041] 3 3 1 2 2 2 1 1 1 1 2 1 1 2 3 1 3 3 1 2 2 3 2 2 2 1 3 3 1 2 2 3 3 3
## [2075] 1 2 1 2 1 2 1 3 1 2 2 2 3 3 3 1 3 2 1 3 2 1 1 1 3 3 2 1 3 2 3 1 3 1
## [2109] 2 3 3 2 3 2 2 2 1 1 1 3 2 1 3 2 2 2 2 1 1 1 3 1 3 1 1 2 3 1 2 3 1 1
## [2143] 1 1 3 2 3 1 1 2 3 2 1 1 1 1 1 3 1 2 3 3 1 2 2 1 2 3 3 2 3 2 1 2 1 1
## [2177] 3 1 2 3 1 3 1 2 2 3 1 3 3 1 2 1 3 1 3 1 1 2 1 1 1 3 2 1 3 1 2 1 3 1
## [2211] 1 2 1 2 1 1 1 1 1 2 3 1 3 1 3 2 2 1 1 2 3 1 3 2 1 3 2 1 3 1 1 2 3 3
## [2245] 3 3 2 3 1 1 2 3 2 1 3 3 3 1 1 1 3 1 1 3 1 1 2 1 3 2 3 1 3 1 3 2 1 1
## [2279] 1 1 3 3 3 1 3 1 1 1 3 3 1 2 1 1 2 1 1 2 3 3 1 3 3 1 1 2 3 3 2 2 1 3
## [2313] 3 2 3 1 2 1 1 3 2 1 1 3 3 3 1 2 2 1 3 2 1 1 3 2 1 3 3 2 1 1 2 2 1 1
## [2347] 1 1 2 1 2 1 3 3 2 2 2 3 2 1 2 3 3 3 2 3 3 3 3 3 3 2 2 1 3 3 1 1 3 1
## [2381] 3 2 3 2 2 3 2 2 3 2 3 2 1 1 2 2 2 1 1 1 3 1 2 2 1 3 2 1 1 1 1 3 2 3
## [2415] 3 2 2 2 2 3 2 3 2 2 2 3 2 3 2 1 2 1 2 3 1 3 2 1 3 2 3 1 1 3 2 1 2 1
## [2449] 1 2 1 1 3 2 1 3 1 3 1 1 2 2 2 1 1 1 1 3 3 1 2 1 1 2 1 2 1 2 2 1 1 1
## [2483] 3 3 1 1 3 1 3 3 2 2 2 3 2 2 2 1 1 3 1 1 1 1 1 1 2 1 2 3 3 1 3 2 1 2
## [2517] 1 3 1 2 3 3 1 2 3 1 3 2 3 1 3 1 3 2 1 1 1 3 3 1 1 3 3 1 2 1 3 2 1 2
## [2551] 1 3 2 3 1 2 2 1 1 3 3 1 1 2 3 3 3 3 2 1 1 1 1 1 2 1 1 1 1 2 2 2 3 2
## [2585] 3 1 2 1 2 3 3 2 3 3 2 1 1 2 2 1 1 1 1 3 3 1 3 3 3 1 2 2 3 1 1 1 3 1
## [2619] 1 2 3 1 2 3 2 3 1 1 3 1 1 2 2 3 1 2 1 3 1 1 3 1 3 2 3 1 1 1 2 1 1 1
## [2653] 1 1 1 2 1 2 1 1 1 3 3 3 3 2 2 1 3 1 3 1 1 1 1 1 3 3 3 2 3 3 1 3 1 3
## [2687] 1 1 1 1 3 1 3 2 2 2 3 2 1 1 1 1 2 2 1 1 1 1 1 1 3 2 2 3 2 1 1 3 1 3
## [2721] 1 3 3 1 1 1 3 3 1 1 1 2 2 1 1 2 2 1 2 1 2 3 3 1 1 2 2 1 1 1 3 2 1 1
## [2755] 3 2 1 2 2 2 2 1 1 1 1 3 1 1 1 2 2 2 3 2 1 3 3 1 2 3 2 1 1 2 2 1 1 1
## [2789] 3 2 2 3 2 2 2 1 3 2 1 3 3 3 3 3 2 3 2 2 2 2 1 3 3 1 1 3 3 1 3 3 2 2
## [2823] 3 2 3 1 3 1 3 2 3 3 3 2 3 3 2 1 3 3 3 2 3 1 1 3 3 1 3 1 3 3 2 1 3 2
## [2857] 2 1 2 1 1 3 3 3 1 3 3 2 2 2 3 1 1 2 3 1 3 2 1 3 1 1 2 1 1 1 2 1 3 1
## [2891] 3 1 3 2 1 2 1 2 1 1 1 2 2 2 2 2 2 3 2 2 1 2 3 3 3 1 1 3 3 2 2 1 1 1
## [2925] 1 3 1 3 1 3 2 1 3 1 1 1 1 1 1 2 1 1 1 2 3 1 2 2 1 1 2 1 1 1 1 2 3 2
## [2959] 3 3 1 1 3 2 3 1 2 3 1 1 1 1 3 1 1 2 2 1 1 1 1 1 1 1 2 2 2 2 1 3 2 1
## [2993] 2 1 1 1 3 3 1 1 1 2 3 1 1 3 2 1 1 1 2 1 1 1 2 2 3 1 2 3 3 1 2 1 2 1
## [3027] 3 2 1 1 1 1 3 3 1 1 1 3 1 3 1 3 1 2 1 3 1 3 2 1 2 3 1 3 2 1 1 2 1 2
## [3061] 1 1 2 1 1 1 2 3 2 2 1 1 2 1 1 1 2 1 1 1 3 2 1 2 1 2 1 1 1 2 1 3 1 2
## [3095] 1 2 1 1 3 1 1 3 1 3 2 3 2 2 3 1 3 1 2 1 2 3 1 1 1 1 1 2 1 3 2 1 2 2
## [3129] 1 1 1 1 1 3 2 2 1 2 1 2 3 1 2 2 1 3 2 1 1 1 2 1 2 2 2 1 3 1 2 1 1 2
## [3163] 3 2 2 3 1 1 2 3 2 3 2 2 1 2 1 3 3 1 3 3 2 2 3 2 1 1 1 3 2 2 3 2 1 1
## [3197] 1 3 1 2 3 1 1 3 1 3 2 2 3 3 2 2 2 3 1 1 2 1 1 1 2 1 3 1 3 3 2 3 1 3
## [3231] 1 2 3 2 1 1 1 2 1 1 3 3 3 3 2 1 2 3 3 3 3 1 2 2 1 1 2 1 3 1 2 1 3 1
## [3265] 3 1 3 3 3 2 1 3 1 3 3 3 3 1 2 1 1 3 2 3 3 3 2 1 1 1 2 2 1 2 1 3 1 1
## [3299] 3 1 3 3 2 1 3 3 1 2 1 3 1 2 3 2 3 2 2 1 2 3 1 2 1 2 2 3 2 1 1 2 3 3
## [3333] 3 1 1 1 1 2 1 1 1 2 1 1 1 3 1 3 3 2 1 2 3 3 2 1 3 1 3 1 1 1 1 2 1 2
## [3367] 2 1 1 2 2 1 2 2 1 2 1 2 1 3 3 1 3 1 3 1 3 3 1 3 3 2 2 2 3 3 3 1 2 3
## [3401] 3 3 1 3 1 1 1 3 3 1 1 3 2 2 1 1 1 1 3 1 3 3 1 2 1 1 1 1 1 2 2 2 1 1
## [3435] 1 1 1 3 3 3 1 1 2 1 1 3 1 2 3 3 2 1 1 3 3 1 1 1 1 1 1 1 2 2 1 2 3 1
## [3469] 2 1 2 1 2 1 1 2 2 1 1 2 1 3 2 3 1 1 1 2 1 1 1 1 1 2 1 1 3 1 3 3 2 1
## [3503] 3 1 3 2 3 2 3 3 2 3 2 3 2 3 1 3 2 1 2 3 2 3 1 3 1 1 1 1 3 1 2 1 2 3
## [3537] 1 1 3 3 1 1 2 1 1 3 3 3 2 2 1 3 1 2 2 3 1 1 1 2 2 1 1 1 1 1 2 1 1 3
## [3571] 2 2 2 3 1 1 1 3 2 1 3 1 3 1 2 2 1 2 2 2 3 1 1 2 1 3 3 1 2 1 1 3 2 1
## [3605] 2 3 1 3 1 2 1 3 2 3 1 2 1 2 3 1 3 1 3 2 1 3 3 1 1 3 1 3 1 1 2 3 2 3
## [3639] 2 1 3 3 2 2 1 2 2 3 2 3 3 3 3 1 2 1 1 3 2 2 1 3 2 3 2 2 1 2 3 3 3 1
## [3673] 2 3 3 1 1 3 1 3 2 1 2 2 3 2 1 1 1 2 1 3 1 3 2 3 3 1 3 2 3 1 1 3 1 2
## [3707] 1 1 1 3 1 1 1 3 3 2 2 1 1 1 1 2 2 3 3 2 2 3 1 1 1 1 3 1 3 2 3 1 3 1
## [3741] 1 3 3 1 3 3 2 1 1 1 1 1 2 3 3 1 3 3 1 3 1 1 2 1 1 2 3 2 3 2 1 3 2 2
## [3775] 1 1 2 1 2 3 1 1 1 2 3 2 1 2 3 2 1 1 1 2 1 3 1 2 3 3 3 3 1 2 2 2 3 1
## [3809] 3 3 2 3 3 3 3 2 2 1 3 3 2 1 1 1 1 1 1 3 1 1 2 3 2 1 2 3 2 3 2 1 2 1
## [3843] 1 2 1 1 3 2 1 3 3 1 1 3 1 3 1 1 1 2 1 1 2 3 1 1 3 3 3 1 1 3 3 3 1 2
## [3877] 3 1 3 1 3 1 2 1 1 3 3 3 3 3 1 1 3 1 1 2 3 1 2 1 3 1 1 1 1 2 1 2 3 1
## [3911] 1 1 1 1 1 1 1 1 3 1 1 2 3 1 1 1 3 1 3 3 1 2 1 2 1 1 3 3 1 1 1 2 1 3
## [3945] 1 1 3 1 1 1 1 1 1 1 1 3 1 2 3 1 3 3 1 1 3 1 3 1 2 2 2 3 3 3 2 1 1 3
## [3979] 1 3 1 1 2 2 3 3 1 1 1 1 3 2 1 3 2 1 3 2 3 1 1 2 1 1 1 2 1 3 1 2 1 2
## [4013] 1 3 1 3 1 3 3 3 1 3 3 1 3 3 2 1 3 1 1 3 3 1 1 1 1 1 3 3 1 3 1 3 1 2
## [4047] 2 2 1 2 3 1 1 3 1 1 1 2 1 3 2 2 2 3 1 1 1 1 2 1 3 3 1 2 3 1 3 3 3 1
## [4081] 1 3 2 3 1 1 3 1 1 1 1 3 1 2 2 1 1 1 3 1 1 1 2 1 1 1 1 3 1 1 2 3 1 2
## [4115] 1 3 2 1 1 3 1 3 1 2 1 1 1 2 2 1 1 3 2 3 3 3 3 3 2 3 1 3 1 1 1 1 2 3
## [4149] 1 2 3 1 1 1 3 2 3 1 2 3 2 3 2 2 2 1 2 2 3 3 2 2 2 2 3 1 1 3 3 3 2 2
## [4183] 1 1 1 1 1 3 1 3 3 1 1 1 1 3 1 1 1 3 3 1 2 1 1 1 2 2 3 1 2 2 3 2 2 1
## [4217] 2 2 1 3 3 2 1 1 3 3 1 1 1 1 3 1 2 1 2 2 2 2 3 1 3 2 3 1 1 2 1 2 3 1
## [4251] 3 3 2 3 1 1 1 3 1 2 2 3 3 1 1 1 1 3 3 1 1 3 1 1 3 2 2 3 2 2 3 3 1 1
## [4285] 2 3 3 1 1 3 3 3 3 2 1 3 2 1 3 1 2 3 1 1 3 1 1 1 1 1 3 1 3 1 3 1 1 1
## [4319] 1 1 3 3 2 1 1 2 1 3 1 1 1 2 3 1 1 1 1 1 1 1 1 3 2 2 1 2 1 2 1 3 2 3
## [4353] 1 2 1 1 1 2 3 2 1 3 2 3 1 1 3 3 1 2 1 2 3 1 1 1 1 2 1 1 1 1 2 1 2 2
## [4387] 1 1 1 2 1 2 2 1 2 2 1 1 1 2 3 3 3 2 3 2 1 1 2 1 1 1 3 1 1 1 2 1 1 3
## [4421] 2 1 1 3 2 1 3 3 2 1 3 2 2 3 2 2 1 2 1 1 1 1 1 1 1 2 1 1 3 1 1 1 1 1
## [4455] 2 1 1 3 2 1 1 3 2 2 1 3 1 2 3 3 2 3 1 1 1 3 1 1 2 2 3 1 1 3 1 3 3 1
## [4489] 2 1 1 2 1 2 2 2 1 2 2 3 3 1 2 1 1 2 3 1 1 2 1 1 3 1 3 1 1 1 1 2 2 1
## [4523] 3 2 1 3 2 1 3 1 1 1 1 2 1 2 1 1 2 1 2 2 1 1 1 1 1 3 3 2 1 3 3 3 1 1
## [4557] 3 3 2 1 3 1 1 1 3 3 1 3 2 3 1 2 1 1 2 1 3 3 3 2 1 3 1 2 1 1 3 1 1 2
## [4591] 1 3 3 2 1 2 1 2 2 3 1 1 2 3 2 1 1 3 2 3 3 3 1 3 3 3 2 2 2 3 1 2 1 1
## [4625] 2 2 1 1 3 3 3 2 2 3 1 3 2 2 3 3 2 1 1 3 2 2 3 2 3 1 2 1 3 1 2 1 3 2
## [4659] 1 3 2 2 1 3 3 1 1 3 2 2 3 3 3 1 1 2 1 3 3 1 1 2 1 2 1 3 1 3 1 3 1 1
## [4693] 2 1 2 2 1 2 1 3 2 2 3 2 3 3 2 1 3 1 1 3 1 2 2 1 1 1 3 2 1 3 1 1 1 1
## [4727] 3 3 1 2 1 1 3 2 3 3 1 1 1 3 3 3 1 1 2 1 2 2 1 1 1 3 3 3 3 3 1 1 1 3
## [4761] 3 1 2 1 3 3 2 1 3 2 1 2 2 1 3 1 1 3 1 1 3 1 2 3 3 3 3 1 3 3 3 1 1 3
## [4795] 1 1 1 2 1 2 1 3 3 1 3 1 1 1 1 1 1 2 2 3 1 1 1 1 3 3 1 1 3 3 1 2 1 1
## [4829] 3 3 3 3 3 3 1 2 2 1 3 1 1 2 2 1 1 2 1 3 2 3 2 3 3 1 3 1 1 1 1 3 1 3
## [4863] 3 1 3 1 2 1 2 3 2 2 1 1 3 3 1 3 2 1 1 2 1 1 3 1 1 1 1 1 1 2 1 3 1 1
## [4897] 2 3 1 3 1 1 1 1 1 1 2 3 3 1 3 1 1 3 1 1 1 2 2 3 1 1 2 3 1 2 2 2 3 1
## [4931] 1 3 2 2 1 3 1 3 1 2 1 3 1 1 1 1 2 2 3 1 1 3 2 1 1 1 2 2 1 1 1 1 3 1
## [4965] 1 2 1 1 2 3 3 1 1 1 1 3 1 1 1 1 3 1 3 3 3 2 2 1 3 1 3 2 3 1 1 1 1 1
## [4999] 2 3 1 1 1 3 1 1 1 1 1 1 3 1 1 2 3 3 1 3 1 2 1 1 1 1 1 1 1 3 1 1 2 2
## [5033] 2 3 3 1 1 1 1 2 1 1 2 1 1 3 3 2 1 3 3 2 3 2 2 1 1 3 2 2 1 3 1 2 2 3
## [5067] 3 3 3 1 2 1 1 1 1 1 3 3 2 2 3 2 1 1 1 1 2 1 3 2 1 2 1 3 1 1 1 3 3 2
## [5101] 2 3 2 3 1 2 3 2 2 3 2 1 1 2 1 1 2 1 1 3 3 1 3 2 1 3 1 1 3 1 1 3 2 1
## [5135] 1 1 3 2 2 1 3 3 2 3 3 3 1 3 2 1 1 1 2 3 2 1 1 3 1 1 1 1 1 3 2 1 1 1
## [5169] 3 3 2 1 2 1 3 3 2 2 2 1 2 1 1 3 1 1 1 1 1 2 1 2 2 3 1 1 3 2 2 3 1 2
## [5203] 3 2 1 3 1 1 2 1 2 2 1 3 1 1 1 3 1 2 1 1 2 2 3 3 1 1 3 3 3 1 3 3 1 2
## [5237] 2 3 2 1 1 3 1 1 2 2 1 1 1 2 3 3 1 3 3 2 1 1 1 3 1 2 3 3 3 2 1 1 1 3
## [5271] 2 1 1 2 1 1 1 3 2 3 2 1 3 1 1 1 2 1 1 1 3 1 2 1 1 2 1 1 2 2 3 2 2 1
## [5305] 3 1 1 1 3 3 1 2 2 3 1 1 2 2 1 1 1 2 2 3 1 1 3 3 1 3 3 1 1 1 1 1 1 1
## [5339] 3 1 3 1 1 2 2 2 1 2 3 3 3 2 1 1 3 2 3 2 1 2 1 1 2 1 3 3 3 2 3 1 1 1
## [5373] 2 3 1 3 1 3 3 3 1 1 3 3 1 2 1 2 1 2 3 1 3 2 1 2 2 2 3 3 1 2 3 1 2 1
## [5407] 1 1 3 3 2 1 1 2 1 1 3 2 2 1 3 1 3 1 2 2 1 3 1 1 1 3 1 1 3 2 3 2 1 1
## [5441] 2 3 1 3 1 1 2 2 1 3 1 3 3 3 1 2 2 3 2 1 3 2 2 1 1 1 2 2 1 2 3 1 3 2
## [5475] 1 1 2 2 3 3 2 1 1 1 1 1 3 3 1 3 2 1 3 1 1 3 3 3 2 1 1 3 3 1 1 3 3 1
## [5509] 3 2 1 1 1 1 1 3 1 3 3 3 3 3 3 1 3 3 1 1 2 1 1 3 1 1 3 1 3 2 1 3 2 1
## [5543] 1 1 3 3 2 1 1 3 3 1 3 1 2 3 3 3 1 3 3 1 2 3 1 1 1 2 1 3 2 1 1 2 1 1
## [5577] 3 1 1 1 2 3 3 3 1 1 1 2 1 2 1 3 1 2 1 1 3 1 3 2 1 3 3 1 1 2 1 3 2 1
## [5611] 1 2 3 3 1 2 1 3 1 3 1 1 3 1 1 3 3 1 1 1 1 2 3 3 1 2 1 3 3 3 3 2 2 3
## [5645] 3 3 2 2 1 2 2 2 3 1 2 3 3 2 1 2 1 1 1 1 2 3 3 1 1 1 1 3 2 3 1 3 1 3
## [5679] 3 1 3 1 1 1 2 1 1 3 3 1 2 1 1 3 2 1 3 3 3 1 1 1 1 3 1 1 1 1 3 2 2 1
## [5713] 2 3 1 2 2 1 1 1 3 1 1 1 2 3 1 3 2 3 3 2 3 1 1 1 1 1 2 1 1 3 1 1 3 3
## [5747] 3 1 2 1 3 2 3 1 3 2 2 2 2 3 3 1 1 1 3 3 1 2 3 3 3 3 1 2 3 2 1 1 1 3
## [5781] 2 1 2 1 1 1 2 2 1 3 1 1 2 1 3 1 2 1 2 1 2 2 3 3 1 1 1 3 2 1 1 2 1 2
## [5815] 2 1 3 3 1 2 3 3 3 2 3 3 1 3 1 1 3 1 1 3 2 1 3 3 2 1 1 1 1 3 1 3 1 3
## [5849] 2 1 3 2 2 2 2 1 1 1 2 1 1 2 2 2 1 1 1 2 1 3 3 2 1 2 3 2 2 2 3 1 1 3
## [5883] 2 1 3 1 2 1 1 1 1 1 3 1 3 3 1 3 2 1 3 2 3 3 2 3 1 1 2 2 3 1 1 3 1 3
## [5917] 1 2 3 1 3 1 2 3 3 1 2 1 2 2 3 3 3 1 1 1 3 1 2 3 2 3 3 1 1 1 3 1 1 3
## [5951] 2 3 3 3 1 1 1 1 1 1 3 1 1 1 3 3 2 1 1 3 1 1 3 3 1 1 1 1 2 3 3 1 1 1
## [5985] 3 1 2 3 3 3 1 1 3 1 3 3 1 1 1 1 3 3 3 1 1 2 1 1 1 3 1 1 2 1 2 1 2 3
## [6019] 2 1 3 1 1 3 1 3 3 1 2 1 3 1 2 3 1 1 1 2 1 3 2 1 3 1 2 3 1 3 1 2 2 3
## [6053] 1 1 1 1 3 3 3 1 1 3 1 1 2 3 3 3 3 1 1 3 1 1 3 3 1 3 3 3 2 1 2 1 1 1
## [6087] 1 1 2 1 1 1 2 3 3 1 3 1 3 1 1 1 2 3 1 3 1 1 3 3 1 2 2 1 2 2 3 1 1 1
## [6121] 1 1 1 2 1 1 2 3 1 1 1 2 2 2 2 1 1 1 1 2 3 2 3 1 1 2 1 3 3 3 3 1 1 3
## [6155] 1 1 1 1 3 1 3 2 1 1 3 1 1 2 2 1 1 1 2 1 3 2 1 2 2 1 1 3 3 3 1 2 3 3
## [6189] 1 1 3 1 1 1 3 3 3 1 3 1 1 1 2 1 2 1 1 2 3 2 3 1 3 1 3 1 1 2 3 3 1 2
## [6223] 1 1 2 1 2 3 1 2 3 2 1 3 3 1 3 2 2 3 2 1 1 3 3 2 3 1 3 1 3 3 1 2 2 1
## [6257] 1 1 2 1 2 2 1 1 3 1 1 1 1
## 
## Within cluster sum of squares by cluster:
## [1] 17530.05 17906.78 11785.89
##  (between_SS / total_SS =  35.0 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"    
## [5] "tot.withinss" "betweenss"    "size"         "iter"        
## [9] "ifault"

## segmento
##    1    2    3 
## 2842 1574 1853

Quantidade de interações até chegar nos clusters:

## [1] 4

Group.1	fixedacidity	volatileacidity	citricacid	residualsugar	chlorides	freesulfurdioxide	totalsulfurdioxide	density	pH	sulphates	alcohol	quality
1	-0.3468971	-0.4233652	0.0042857	-0.4483549	-0.4379859	-0.0903934	0.0373909	-0.8786450	-0.0540633	-0.2867921	0.5694176	5.989796
2	0.8624373	1.1769188	-0.3264052	-0.6076420	0.9196867	-0.8429238	-1.1907549	0.7006338	0.5412253	0.8277140	-0.1275825	5.572427
3	-0.2005368	-0.3503866	0.2706863	1.2038063	-0.1094608	0.8546466	0.9541194	0.7524616	-0.3768164	-0.2632265	-0.7649595	5.574204

Grupo 4 tem acido volatil e ph altos, Grupo 2 são os vinhos com bastante residuos de açucar e menos alcolícos.

Componentes Principais (PCA)

Com a dataset sem o tipo do vinho foi testado o método dos Componentes Principais:

acpcor <- prcomp(vinhos_noColor, scale = TRUE) 
summary(acpcor)

## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6
## Standard deviation     1.7531 1.6186 1.2844 1.03650 0.90988 0.80824
## Proportion of Variance 0.2561 0.2183 0.1375 0.08953 0.06899 0.05444
## Cumulative Proportion  0.2561 0.4744 0.6119 0.70142 0.77041 0.82485
##                            PC7     PC8     PC9    PC10    PC11    PC12
## Standard deviation     0.74724 0.71475 0.68246 0.55115 0.47795 0.18598
## Proportion of Variance 0.04653 0.04257 0.03881 0.02531 0.01904 0.00288
## Cumulative Proportion  0.87138 0.91395 0.95277 0.97808 0.99712 1.00000

Pode-se observar que o número de componentes prinpais que explicam a maior parte dos componentes é 3, por tanto, decidiu-se por utilizar 3 componentes.

Exibição de cada componente

Criando um novo dataset com os componentes princpais

vinhos_cpa <-cbind(escore1,escore2, escore3,escore4 ,escore5)

Utilizando o método hierárquico com PCA

Observando o dendograma podemos cortar em 3 grandes grupos:

Utilizando o método não hierárquico com PCA

Determinando a quantidade de clusters

set.seed(333)
output_cluster<-kmeans(vinhos_cpa,3,iter=100)

clus_vinhos_cpa<-output_cluster$cluster
table (clus_vinhos_cpa)

## clus_vinhos_cpa
##    1    2    3 
## 1600 1924 2745

Assim os vinhos ficam agrupados da seguinte maneira

Group.1	fixedacidity	volatileacidity	citricacid	residualsugar	chlorides	freesulfurdioxide	totalsulfurdioxide	density	pH	sulphates	alcohol	quality	Vinho
1	0.8460029	1.1610755	-0.3249314	-0.6052805	0.9061316	-0.8441997	-1.1728104	0.6882294	0.5334011	0.8144639	-0.1332965	5.553125	-1.5993643
2	-0.1981442	-0.3470284	0.2550077	1.1412774	-0.1139558	0.8286189	0.9426569	0.7189004	-0.3709510	-0.2700960	-0.7657535	5.546258	0.5734281
3	-0.3542351	-0.4335294	0.0106578	-0.4471289	-0.4482913	-0.0887225	0.0228870	-0.9050387	-0.0509042	-0.2854199	0.6144204	6.035337	0.5303123

Vinhos

FIAP-06IA - Carlos Martinelli, Jônatas Bertolazzo, Letticia Nicoli, Renato Ramos

6/18/2019